home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVLIST / DEMO.PAS next >
Pascal/Delphi Source File  |  1991-03-16  |  28KB  |  734 lines
  1.   Program ListDemo;
  2.   {********************************************************************
  3.    * LISTDEMO                                                         *
  4.    * This program provides a simple demonstration of using the TVLIST *
  5.    * unit for Turbo Vision TCollection class objects.  Refer to       *
  6.    * TVLIST.DOC for documentation.                                    *
  7.    *                                                                  *
  8.    * Problem : Your store has list of merchandise.  For your inventory*
  9.    *          system you want to be able to maintain these lists, as  *
  10.    *          well as use the list to create invoices.  (Well it is   *
  11.    *          just a demo!)                                           *
  12.    *                                                                  *
  13.    *                                                                  *
  14.    *  Copyright 1991 McQuay Technologies                              *
  15.    *  2329 E. Cortez Phoenix AZ 85028                                 *
  16.    *  100 Sycamore Richmond TX                                        *
  17.    *  Prodigy ID WPTD01E Compuserve 72307,320                         *
  18.    *  Released into the Public Domain, Give Credit were Credit Is Due *
  19.    *                                                                  *
  20.    ********************************************************************}
  21.  
  22.   uses Objects,  app, Drivers, Menus, Views, Dialogs,  TVList, MsgBox;
  23.  
  24.  {===============================================================
  25.   User List Basics
  26.   ---------------------------------------------------------------
  27.   TMyRecord  Class
  28.   This object Class provides the basic element for your list.  It
  29.   provides slots fon each item.
  30.   ===============================================================}
  31. type
  32.   PMyRecord = ^TMyRecord;
  33.   TMyRecord = object(TObject)
  34.     Partname:Pstring;
  35.     PartCode:word;
  36.     inventory:word;
  37.     Price:real;
  38.     constructor init(AName:string;APartCode,NumberOnHand:word;APrice:real);
  39.     destructor done;  virtual;
  40.     procedure Store(var S:TStream); virtual;
  41.     procedure Load(var S:TStream); virtual;
  42.     end;
  43.  {===============================================================
  44.   TMyList Class
  45.   This class is a descendant of TSortedList which is a descendant of
  46.   TSortedCollection.  It is a sorted list of PMyRecord.  Keyof()
  47.   and Compare() provide the QSORT like routines needed for
  48.   TSortedCollection to maintain a sorted list.  GetItemText()
  49.   retrieves a string for each record.  Since each record of MyRecord
  50.   is not a string record it must convert the MyRecord slots to
  51.   string values for display.  CreatItem() and EditItem() are
  52.   methods that allow the editing of PMyRecord records using
  53.   dialog boxes.
  54.   ===============================================================}
  55.   type
  56.   PMyList = ^TMyList;
  57.   TMyList = Object(TSortedList)
  58.     function KeyOf(Item:pointer):pointer; virtual;
  59.     function Compare(Key1,Key2:pointer):integer; virtual;
  60.     function GetItemText(item:pointer;MaxLen:word):string; virtual;
  61.     function CreateItem(Corner:Tpoint):pointer; virtual;
  62.     procedure editItem(Corner:Tpoint;Item:pointer); virtual;
  63.     End;
  64.  {===============================================================
  65.   TMyOtherList Class
  66.   This class is a descendant of TList which is a descendant of
  67.   TCollection.  It is a list of PMyRecord.  GetItemText()
  68.   retrieves a string for each record.  Since each record of MyRecord
  69.   is not a string record it must convert the MyRecord slots to
  70.   string values for display.  CreatItem() and EditItem() are
  71.   methods that allow the editing of PMyRecord records using
  72.   dialog boxes.   Very similar to TMyList.
  73.   ===============================================================}
  74.   type
  75.   PMyOtherList = ^TMyOtherList;
  76.   TMyOtherList = Object(TList)
  77.     function GetItemText(item:pointer;MaxLen:word):string; virtual;
  78.     function CreateItem(Corner:Tpoint):pointer; virtual;
  79.     procedure editItem(Corner:Tpoint;Item:pointer); virtual;
  80.     End;
  81.  
  82.   { This is a header used with TMyRecord Lists for display of each
  83.     records data.  This matches how GetItemText() formats each
  84.     records data. }
  85.   const
  86.     MyBoxHeader = 'Part Name            Code  Stock  Price';
  87.  {===============================================================
  88.   TMyRecord  Methods
  89.   ===============================================================}
  90.     constructor TMyRecord.init
  91.                  (AName:string;APartCode,NumberOnHand:word;APrice:real);
  92.       begin
  93.       PartName := NewStr(AName);
  94.       PartCode := APartCode;
  95.       Inventory:= NumberOnHand;
  96.       Price := APrice;
  97.       end;
  98.    {----------------------------}
  99.     destructor TMyRecord.done;
  100.       begin
  101.       disposeStr(PArtName);
  102.       end;
  103.    {----------------------------}
  104.     procedure TMyRecord.Store(var S:TStream);
  105.       begin
  106.       S.writeStr(PartName);
  107.       S.write(PartCode,sizeof(PartCode));
  108.       S.Write(Inventory,Sizeof(Inventory));
  109.       S.write(Price,sizeof(Price));
  110.       end;
  111.    {----------------------------}
  112.     procedure TMyRecord.Load(var S:TStream);
  113.       begin
  114.       Partname := S.readStr;
  115.       S.read(PartCode,sizeof(PartCode));
  116.       S.read(Inventory,Sizeof(Inventory));
  117.       S.read(Price,sizeof(Price));
  118.       end;
  119.    {---------------------------------------------------------
  120.     Dialog Setup Info
  121.     This is info used in a generic Dialog Box for editing
  122.     PMyRecord data.  This provides info on the location
  123.     and labeling of the various fields.
  124.     ---------------------------------------------------------}
  125.    Type
  126.      TPartsDialogSetup = record
  127.        FS:byte;  { Field Size }
  128.        L:Pstring;{ Label      }
  129.        Y:byte;   { Y of Field }
  130.        end;
  131.     Fields = (PartName,PartCode,PartInventory,PartPrice);
  132.   Const
  133.     { Size if Input Fields }
  134.     PartNameSize = 20;
  135.     PartCodeSize = 5;
  136.     PartPriceSize = 6;
  137.     PartInventorySize = 5;
  138.  
  139.     { Label for each field }
  140.     SPartNameLabel: string = 'Part Name';
  141.     SPartCodeLabel: string = 'Part Code';
  142.     SPartInventoryLabel: string = 'Inventory';
  143.     SPartPriceLabel: string = 'Part Price @';
  144.  
  145.     { An array of location, size, and labeling info for each field
  146.       FS = FieldSize   L = @ to a Label   Y =line in Dialog for field}
  147.     PD : array[PartName..PartPrice] of TPartsDialogSetup =
  148.       ( (FS:PartNameSize;L:@SPartNameLabel;Y:2),
  149.         (FS:PartCodeSize;L:@SPartCodeLabel;Y:4),
  150.         (FS:PartInventorySize;L:@SPartInventoryLabel;Y:6),
  151.         (FS:PartPriceSize;L:@SPartPriceLabel;Y:8) );
  152.  
  153.     {---------------------------------
  154.      This procedure provides a Generic
  155.      Dialog Box to edit a TMyRecord
  156.      class instance.
  157.      ---------------------------------}
  158.     procedure TMyList_EditDialog(TD:Pdialog; var P:PMyRecord);
  159.       var
  160.         { Record used to set and Get Data from Dialog }
  161.         DataRecord: record
  162.           SPartname:STring[PartNameSize];
  163.           SPartCode:String[PartCodeSize];
  164.           Sinventory:String[PartInventorySize];
  165.           SPrice:String[PartPriceSIze];
  166.           end;
  167.         { pointers used for inserting Fields }
  168.         TV:PView;
  169.         TL:PLabel;
  170.         { Used to locate Fields }
  171.         R:Trect;
  172.         { A loop interator }
  173.         Field:Fields;
  174.         { Used in data conversion }
  175.         Err:word;
  176.         Aword:Word;
  177.         Areal:Real;
  178.  
  179.       begin
  180.         { Set Up Main Dialog }
  181.         { Loop through field const Array and setup Fields }
  182.         with TD^ do
  183.           begin
  184.           for Field := PartName to PartPrice do
  185.             with PD[Field] do
  186.               begin
  187.               R.Assign(2,Y,FS+5,Y+1);
  188.               TV := new(PInputLine, init(R,FS));
  189.               insert(TV);
  190.               R.Assign(2,y-1,Length(L^)+3,Y);
  191.               insert(new(Plabel,init(R,L^,TV)));
  192.               end;
  193.           { Setup OK and Cancel Buttons }
  194.           R.assign(2,10,20,12);
  195.           Insert(new(PButton, init(R,'Ok',cmOk,bfNormal)));
  196.           R.assign(23,10,40,12);
  197.           Insert(new(PButton, init(R,'Cancel',cmCancel,bfDefault)));
  198.           { Skip to first field }
  199.           SelectNext(False);
  200.           { setup initial data }
  201.           with P^ do
  202.             with DataRecord do
  203.               begin
  204.               if PartName <> nil then
  205.                 SPartName := Copy(PartName^,1,PartNAmeSize)
  206.               else
  207.                 SPArtName := '';
  208.               str(PartCode:PartCodeSize,SPartCode);
  209.               str(Inventory:PartInventorySize,SInventory);
  210.               str(Price:PartPriceSize:2,SPrice);
  211.               end;
  212.           SetData(DataRecord);
  213.           end;
  214.        { OK execute dialog and check if cmOk returned }
  215.        if DeskTop^.execview(TD) = cmOk then
  216.          with P^ do
  217.            begin
  218.            { Ok New Data, let's get it }
  219.            TD^.GetData(DataRecord);
  220.  
  221.            { It is all strings so lets place in our Object }
  222.            with DataRecord do
  223.              begin
  224.              { PartName }
  225.              if PartName<>nil then
  226.                disposestr(PartName);
  227.              PartName := newStr(SPartName);
  228.              { Part Code }
  229.              val(SPartCode,Aword,err);
  230.              if Err=0 then
  231.                PartCode := Aword
  232.              else
  233.                PartCode := 0;
  234.              { Part Inventory }
  235.              val(SInventory,Aword,err);
  236.              if Err=0 then
  237.                Inventory := Aword
  238.              else
  239.                Inventory := 0;
  240.              { Part Price }
  241.              val(SPrice,AReal,err);
  242.              if Err=0 then
  243.                Price := AReal
  244.              else
  245.                Price := 0.0;
  246.              end;
  247.            end;
  248.       end;
  249.  
  250.  {===============================================================
  251.   TMyList  Methods
  252.   ===============================================================}
  253.   { Sort on Partname }
  254.     function TMyList.KeyOf(Item:pointer):pointer;
  255.       begin
  256.         keyof := PMyRecord(item)^.Partname;
  257.       end;
  258.    {----------------------------}
  259.     function TMyList.Compare(Key1,Key2:pointer):integer;
  260.       begin
  261.         if pstring(key1)^ = pstring(key2)^ then
  262.           Compare:=0
  263.         else
  264.           if pstring(key1)^ < pstring(key2)^ then
  265.             Compare := -1
  266.           else
  267.             Compare := 1;
  268.       end;
  269.    {----------------------------}
  270.    { This converts to strings the data fields of a PMyRecord object
  271.      and formats it into a string for display in a lIst Box.        }
  272.     function TMyList.GetItemText(item:pointer;MaxLen:word):string;
  273.       var
  274.         S,SW:string;
  275.       begin
  276.         S:=PMyRecord(Item)^.partname^;
  277.         if length(S)<PartNameSize then
  278.           begin
  279.           fillchar(S[Length(S)+1],PartNameSize-length(S),32);
  280.           S[0] := char(PartNameSize);
  281.           end
  282.         else
  283.           S:=copy(S,1,PartNameSize);
  284.         str(PMyRecord(Item)^.PartCode:PartCodeSize,Sw);
  285.         S := S+Sw;
  286.         str(PMyRecord(Item)^.Inventory:PartInventorySize,Sw);
  287.         S := S+Sw;
  288.         str(PMyRecord(Item)^.Price:PartPriceSize:2,Sw);
  289.         S := S+'  $'+Sw;
  290.         GetItemText := copy(S,1,MaxLen);
  291.       end;
  292.    {----------------------------}
  293.    { Uses TMyList_EditDialog to create a PMyRecord instance }
  294.     function TMyList.CreateItem(Corner:Tpoint):pointer;
  295.       var
  296.         P:PMyRecord;
  297.         TD:PDialog;
  298.         R:Trect;
  299.       begin
  300.         { initialize a blank record }
  301.         P:=new(PMyRecord, init('',0,0,0.0));
  302.  
  303.         { Calculate Dialog Location }
  304.         MakeTrect(Corner,50,15,R);
  305.         TD := new(PDialog, init(R,'Parts Inventory Record'));
  306.         TMyList_EditDialog(TD,P);
  307.         { If canceled then Partname will be nil and cancel create }
  308.         If P^.PartName = nil then
  309.           begin
  310.           P^.done;
  311.           CreateItem := nil;
  312.           end
  313.         else
  314.          CreateItem := P;
  315.       end;
  316.    {----------------------------}
  317.    { Uses TMyList_EditDialog to edit a PMyRecord instance }
  318.     procedure TMyList.editItem(Corner:Tpoint;Item:pointer);
  319.       var
  320.         TD:PDialog;
  321.         R:trect;
  322.       begin
  323.         MakeTrect(Corner,50,15,R);
  324.         TD := new(PDialog, init(R,'Parts Inventory Record'));
  325.         TMyList_EditDialog(TD,PMyRecord(Item));
  326.       end;
  327.    {----------------------------}
  328.  {===============================================================
  329.   TMyOtherList  Methods
  330.   ===============================================================}
  331.    {----------------------------}
  332.    { This converts to strings the data fields of a PMyRecord object
  333.      and formats it into a string for display in a list Box.        }
  334.     function TMyOtherList.GetItemText(item:pointer;MaxLen:word):string;
  335.       var
  336.         S,SW:string;
  337.       begin
  338.         S:=PMyRecord(Item)^.partname^;
  339.         if length(S)<PartNameSize then
  340.           begin
  341.           fillchar(S[Length(S)+1],PartNameSize-length(S),32);
  342.           S[0] := char(PartNameSize);
  343.           end
  344.         else
  345.           S:=copy(S,1,PartNameSize);
  346.         str(PMyRecord(Item)^.PartCode:PartCodeSize,Sw);
  347.         S := S+Sw;
  348.         str(PMyRecord(Item)^.Inventory:PartInventorySize,Sw);
  349.         S := S+Sw;
  350.         str(PMyRecord(Item)^.Price:PartPriceSize:2,Sw);
  351.         S := S+'  $'+Sw;
  352.         GetItemText := copy(S,1,MaxLen);
  353.       end;
  354.    {----------------------------}
  355.    { Uses TMyList_EditDialog to create a PMyRecord instance }
  356.     function TMyOtherList.CreateItem(Corner:TPoint):pointer;
  357.       var
  358.         P:PMyRecord;
  359.         TD:Pdialog;
  360.         R:Trect;
  361.       begin
  362.         { initialize a blank record }
  363.         P:=new(PMyRecord, init('',0,0,0.0));
  364.         { Let the user fill it in }
  365.         MakeTrect(Corner,50,15,R);
  366.         TD := new(PDialog, init(R,'Parts Inventory Record'));
  367.         TMyList_EditDialog(TD,P);
  368.         { If canceled then Partname will be nil and cancel create }
  369.         If P^.PartName = nil then
  370.           begin
  371.           P^.done;
  372.           CreateItem := nil;
  373.           end
  374.         else
  375.          CreateItem := P;
  376.       end;
  377.    {----------------------------}
  378.    { Uses TMyList_EditDialog to edit a PMyRecord instance }
  379.     procedure TMyOtherList.editItem(Corner:TPoint;Item:pointer);
  380.       var
  381.         TD:PDialog;
  382.         R:Trect;
  383.       begin
  384.         TD := new(PDialog, init(R,'Parts Inventory Record'));
  385.         TMyList_EditDialog(TD,PMyRecord(Item));
  386.       end;
  387.    {----------------------------}
  388.  {===========================================================
  389.   Main Application
  390.   This is the main application
  391.   ===========================================================}
  392. const
  393.   cmDialog1         =  $3000;
  394.   cmDialog2         =  $3002;
  395.   cmDialog3         =  $3003;
  396.   cmDialog4         =  $3004;
  397.   type
  398.     TMyApp = object(TApplication)
  399.       procedure HandleEvent(var Event: TEvent); virtual;
  400.       procedure InitMenuBar; virtual;
  401.       procedure InitStatusLine; virtual;
  402.     end;
  403.  {-------------------------------------------------------------
  404.   Here are our lists and our support ListDialogs
  405.   -------------------------------------------------------------}
  406.   Var
  407.     MyList:PMyList;
  408.     MyOtherList:PMyOtherList;
  409.     TestDialog:PListDialog;
  410.     TestSortedDialog : PSortedListDialog;
  411.  {-------------------------------------------------------------
  412.   This initializes our lists
  413.   -------------------------------------------------------------}
  414.   procedure MakeList;
  415.     begin
  416.     MyList := new(PMyList, init(10,2));
  417.     with MyList^ do
  418.       begin
  419.       { Because this is a sorted list (TSortedCollection) we will use
  420.         insert.  If it was not a sorted list we would use AtInsert(O,^) }
  421.       Insert(new(PMyRecord,init('McQuay List ToolBox',1,100,15.0)));
  422.       Insert(new(PMyRecord,init('Turbo Pascal Ver 6.0',2,1,99.0)));
  423.       Insert(new(PMyRecord,init('McQuay TV ToolBox',3,50,30.0)));
  424.       Insert(new(PMyRecord,init('Turbo Assembler',4,1,69.0)));
  425.       Insert(new(PMyRecord,init('Turbo C++',5,1,169.0)));
  426.       Insert(new(PMyRecord,init('Turbo Prolog',6,1,0.0)));
  427.       Insert(new(PMyRecord,init('Object Professional',7,1,99.0)));
  428.       Insert(new(PMyRecord,init('Turbo Debugger',8,1,99.0)));
  429.       end;
  430.     MyOtherList := new(PMyOtherList, init(10,2));
  431.     with MyOtherList^ do
  432.       begin
  433.       { Because this is a not sorted list (TCollection) we will use
  434.         AtInsert(O,^) }
  435.       AtInsert(0,new(PMyRecord,init('Quattro Pro',10,1,100.0)));
  436.       AtInsert(0,new(PMyRecord,init('Paradox Ver 3.5',11,1,175.0)));
  437.       AtInsert(0,new(PMyRecord,init('Microsoft Word',12,1,250.0)));
  438.       AtInsert(0,new(PMyRecord,init('Windows 3.0',13,1,69.0)));
  439.       AtInsert(0,new(PMyRecord,init('dBase IV',14,1,400.0)));
  440.       AtInsert(0,new(PMyRecord,init('TimeLine ver 4',15,1,500.0)));
  441.       AtInsert(0,new(PMyRecord,init('PCTools 6',16,1,79.0)));
  442.       AtInsert(0,new(PMyRecord,init('Freelance',17,1,379.0)));
  443.       end;
  444.    end;
  445.   {------------------------------------------------------------------
  446.    These routines are the Demo Window Support
  447.    ------------------------------------------------------------------}
  448.    const
  449.      MaxText = 9;
  450.      MaxDemo = 6;
  451.    type
  452.      DemoWindowText = array[0..MaxDemo,1..MaxText] of string;
  453.    const
  454.      DemoText : DemoWindowText =
  455.      ( ('HI! Welcome to a demo of the TVLIST unit and Turbo Vision`s',
  456.         'TCollection and TListBox classes.  The TVList unit provides',
  457.         'classes that are designed to make it easier to incorporate',
  458.         'TListBox and TCollection objects in your programs.  TVlist,',
  459.         'classes make it easy to create user interfaces to select items',
  460.         'in a list (Collection) as well as editing, adding, and ',
  461.         'deleteing items in a list.',
  462.         'The F2, F3, F4, and F5 keys each are hotkeys to demos of TVList',
  463.         'objects.  Watch this window for info on each demo. Have FUN!'),
  464.        ('********** Class: TSortedList and TSortedListDialog *********',
  465.         'This dialog box has all available editing and selection',
  466.         'options enabled.  The list box can be scrolled with the cursor',
  467.         'keys or mouse.  Specific items can be found in the list box by',
  468.         'typing a search string, which appears above the box.  As each',
  469.         'key is entered the list box scrolls to the closest matching',
  470.         'item.  Each item when highlighted can be edited or deleted.',
  471.         'Deletes will prompt for appproval before deleting the item.',
  472.         'New items can be added.  Try it then PRESS ESC'),
  473.        ('++++++++++ Class: TSortedList and TSortedListDialog ++++++++',
  474.         'This dialog box has no editing features enabled, but does ',
  475.         'allow selection from the list box. The list box can be scrolled',
  476.         'with the cursor keys, mouse, or by typing a serach string.',
  477.         'Any item can be selected by double clicking on it with the',
  478.         'mouse, or by highlighting it and pressing the return key.',
  479.         'When an item is selected, the dialog can either simply exit',
  480.         'with that slection, or move to the OK Button for verification.',
  481.         'Try highlighting an item and then select it. Now verify OK.'),
  482.        ('================= Class: TList and TListDialog ===============',
  483.         'This dialog is displaying an unsorted list.  Here no editing',
  484.         'features are enabled.  Right now try holding the mouse button',
  485.         'down and moving the cursor above the list box while the list',
  486.         'box is selected.  Notice how the list box scrolls up.  Now try',
  487.         'it below the list box. You can scroll with the cursor, pgup,',
  488.         'pgdn keys as well. You can select the highlighted item with the',
  489.         'Enter key or double click.  With this box there is no verify',
  490.         'after an item is selected.  Try it, highlight and select.'),
  491.        ('----- Class: TList,TSortedList and TListDialogInputField -----',
  492.         'This dialog demonstrates an input field that can be inserted in',
  493.         'any Tdialog object.  This is a descendant of TInputLine.  When',
  494.         'selected it can be used to execute a TListDialog.  Move to one',
  495.         'of the fields and press the INS key.  A ListDialog for your',
  496.         'List is evoked. These are the same as the other three Demo',
  497.         'Dialogs so all capabilities are available.  Even editing,',
  498.         'adding and deleting are available.  Items can be selected and',
  499.         'text of the Item Selected will appear in the field.  Try IT!'),
  500.        ('',
  501.         'Here a TListDialog has been executed.  Now you can use the full',
  502.         'features of the dialog.  Select an item or cancel the dialog',
  503.         'and you will return to your original dialog box that you',
  504.         'designed. Try It!',
  505.         '',
  506.         '',
  507.         '',
  508.         ''),
  509.        ('',
  510.         '***************************************************************',
  511.         '                    Try another one! ',
  512.         '',
  513.         '                  Press F2, F4, F6, or F8',
  514.         '',
  515.         '                    Press Alt-X to Exit ',
  516.         '',
  517.         '***************************************************************')
  518.       );
  519.  
  520.    type
  521.      PDemoWindow = ^TDemoWindow;
  522.      TDemoWindow = object(Twindow)
  523.        N:word;
  524.        procedure SetN(Demo:word);
  525.        procedure Draw; virtual;
  526.        end;
  527.      procedure TDemoWindow.SetN(Demo:word);
  528.        begin
  529.        N := Demo;
  530.        drawview;
  531.        end;
  532.      procedure TDemoWindow.draw;
  533.        var
  534.          i:word;
  535.        begin
  536.        Twindow.draw;
  537.        for i:=1 to MaxText do
  538.          writeStr(2,i,DemoText[N,i],1);
  539.        end;
  540.    Var
  541.      DemoWindow:PDemoWindow;
  542.   {------------------------------------------------------------------
  543.    This routine exercises our Lists, ListDialogs, and ListInputFields
  544.    ------------------------------------------------------------------}
  545.    procedure ListInputFieldDialog;
  546.      var
  547.       MyDialog:PDialog;
  548.       R:Trect;
  549.       FCorner:Tpoint;
  550.       DCorner:Tpoint;
  551.       ReturnRecs : array[1..2] of TListRec;
  552.       Pl:Plabel;
  553.       Pb:PButton;
  554.       PLDIF:PListDialogInputField;
  555.      begin
  556.       R.assign(10,10,60,25);
  557.       MyDialog := new(Pdialog, init(R,'Dialog of Dialog of Lists'));
  558.       with MyDialog^ do
  559.         begin
  560.         { Assign corner of Field }
  561.         FCorner.X := 2;
  562.         FCorner.Y := 2;
  563.         { Assign corner of Dialog }
  564.         DCorner.X := 1;
  565.         DCorner.Y := 10;
  566.         PLDIF :=
  567.            new(PListDialogInputField,
  568.                init(FCorner,DCorner,12,
  569.                    'Parts Edit',sfDoAll,MyList,MyBoxHeader,true));
  570.         insert(PLDIF);
  571.         R.Assign(2,1,40,2);
  572.         insert(new(PLabel,init(R,'Parts Edit/Entry',PLDIF)));
  573.  
  574.         { Assign corner of Field }
  575.         FCorner.X := 2;
  576.         FCorner.Y := 4;
  577.         PLDIF :=
  578.            new(PListDialogInputField,
  579.             init(Fcorner,DCorner,12,
  580.                  'Parts Select',sfSearch,MyList,MyBoxHeader,true));
  581.         insert(PLDIF);
  582.         R.Assign(2,3,40,4);
  583.         insert(new(PLabel,init(R,'Parts Select',PLDIF)));
  584.  
  585.         { Assign corner of Field }
  586.         FCorner.X := 2;
  587.         FCorner.Y := 6;
  588.         PLDIF :=
  589.            new(PListDialogInputField,
  590.             init(Fcorner,DCorner,12,'Other Parts Select',
  591.                  sfFullEdit,MyOtherList,MyBoxHeader,false));
  592.         insert(PLDIF);
  593.         R.Assign(2,5,40,6);
  594.         insert(new(PLabel,init(R,'OtherParts Select',PLDIF)));
  595.  
  596.         R.Assign(2,8,12,10);
  597.         insert(new(PButton, init(R,'OK',cmOk,bfnormal)));
  598.         R.assign(14,8,26,10);
  599.         Insert(new(PButton, init(R,'Cancel',cmCancel,bfDefault)));
  600.         SelectNext(False);
  601.         end;
  602.       DemoWindow^.SetN(4);
  603.       Desktop^.Execview(MyDialog);
  604.       DemoWindow^.SetN(6);
  605.    end;
  606.   {-----------------------------------------------------------------}
  607.   procedure TestThoseDialogs(N:word);
  608.     var
  609.       R:Trect;
  610.       T:TListRec;
  611.       i:integer;
  612.     begin
  613.       R.Assign(10,10,0,0);
  614.      { Start The Dialog List Box on the First Record by passing
  615.       SetData() a TListRec with indec=0                        }
  616.       T.Index := 0;
  617.       case N of
  618.           { Setup The TSortedListDialog  to do all edit, add, delete,
  619.             with prompts on delete and move to OK for Exit after Select. }
  620.         1,2: begin
  621.            if N= 1 then i:= sfDoAll else i:=SfSearch+sfPromptExit;
  622.            TestSortedDialog := new(PSortedListDialog,
  623.                 init(R,'Parts Inventory',i,PsortedList(MyList),
  624.                      MyBoxHeader));
  625.  
  626.           TestSortedDialog^.setData(T);
  627.  
  628.           { Ok Execute the ListDialog and save return Command }
  629.           DemoWindow^.SetN(N);
  630.           i := desktop^.ExecView(TestSortedDialog);
  631.           TestSortedDialog^.GetData(T);
  632.           end;
  633.         3: begin
  634.           { Setup The TListDialog  to just select with no prompting,
  635.             But since this is a sorted list, we will allow it to do incremental
  636.             searching. }
  637.           TestDialog :=
  638.             new(PListDialog,
  639.                 init(R,'Parts Inventory',0,PList(MyOtherList),
  640.                      MyBoxHeader));
  641.           TestDialog^.setData(T);
  642.  
  643.           { Ok Execute the ListDialog and save return Command }
  644.           DemoWindow^.SetN(N);
  645.           i := desktop^.ExecView(TestDialog);
  646.           TestDialog^.GetData(T);
  647.           end;
  648.        end;
  649.        { Alright, if cmOk was returned and T.Item is not nil then
  650.          get the return index and do what is need, in this case
  651.          display a message.  Normally, if the purpose of this Dialog
  652.          was just to edit,add,delete; then the return command would
  653.          have been ignored.                                         }
  654.        if (I=cmOk) and (T.Item<>nil) then
  655.          begin
  656.          R.assign(15,8,75,15);
  657.          MessageBoxRect(R,'You Selected: %s',@PMyRecord(T.item)^.partName,
  658.                          mfOKButton+mfInformation);
  659.          end;
  660.          DemoWindow^.SetN(6);
  661.        end;
  662.  
  663.   {-------------------------------------------------------------------
  664.    This is the main application event handler.  This is where all the
  665.    action is.
  666.    -------------------------------------------------------------------}
  667.   procedure TMyApp.HandleEvent(var Event: TEvent);
  668.   var
  669.     R:Trect;
  670.     I:word;
  671.     T:TListRec;
  672.   begin
  673.     TApplication.HandleEvent(Event);
  674.     if Event.What = evCommand then
  675.     begin
  676.       case Event.Command of
  677.         { The Parts Edit Dialog }
  678.         cmDialog1:TestThoseDialogs(1);
  679.        { The Parts Select Dialog }
  680.        cmDialog2:TestThoseDialogs(2);
  681.        CmDialog3:TestThoseDialogs(3);
  682.        CMDialog4:ListInputFieldDialog;
  683.       end;
  684.       ClearEvent(Event);
  685.     end;
  686.   end;
  687.  
  688. procedure TMyApp.InitMenuBar;
  689. var R: TRect;
  690. begin
  691.   GetExtent(R);
  692.   R.B.Y := R.A.Y + 1;
  693.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  694.     NewSubmenu('~D~ialogs', hcNoContext,newmenu(
  695.     NewItem('Parts Edit Dialog','F2',kbF2,cmDialog1,hcNoContext,
  696.     newItem('Parts Pick Dialog','F4',kbF4,cmDialog2,hcNoContext,
  697.     newItem('Other Pick Dialog','F6',kbF6,cmDialog3,hcNoContext,
  698.     newItem('3 in 1 Dialog','F8',kbF8,cmDialog4,hcNoContext,
  699.     nil))))),nil)
  700.     )));
  701. end;
  702.  
  703. procedure TMyApp.InitStatusLine;
  704. var R: TRect;
  705. begin
  706.   GetExtent(R);
  707.   R.A.Y := R.B.Y - 1;
  708.   StatusLine := New(PStatusLine, Init(R,
  709.     NewStatusDef(0, $FFFF,
  710.       NewStatusKey('', kbF10, cmMenu,
  711.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  712.       NewStatusKey('~F2~ Parts Edit', kbF2, cmdialog1,
  713.       NewStatusKey('~F4~ Parts Select',kbF4, cmDialog2,
  714.       NewStatusKey('~F6~ Other Select',kbF6, cmDialog3,
  715.       NewStatusKey('~F8~ 3 in 1',kbF8, cmDialog4,
  716.       nil)))))),
  717.     nil)
  718.   ));
  719. end;
  720.  
  721. var
  722.   MyApp: TMyApp;
  723.   R:Trect;
  724. begin
  725.   MakeList;
  726.   MyApp.Init;
  727.   R.Assign(7,0,73,11);
  728.   DemoWindow :=new(PdemoWindow,init(R,' TVList Demo',0));
  729.   Desktop^.insert(DemoWindow);
  730.   MyApp.Run;
  731.   MyApp.Done;
  732. end.
  733. {----------------------------------------------------}
  734.